PC WORLD Online - Word ▌τin Faydal² Makrolar
Hesap Makinesi
▌■te tamamen Word makro komutlar² ile yarat²lm²■ minik bir hesap makinesi. D÷rt i■lem, ⁿs alma, karek÷k alma komutlar²n² iτeren makromuz basit formⁿlleri de τ÷zⁿmleyebiliyor. Hesaplama sonucunu istedi≡inizde ekleme noktas²n²n bulundu≡u konumdan itibaren Word belgesine yap²■t²rabiliyor. Bu makroyu istedi≡iniz gibi dⁿzenleyerek di≡er i■lemleri de ekleyerek ôak²ll²ö bir Word hesap makinas² yaratabilirsiniz.
Sub MAIN
true = - 1
false = 0
Again:
Begin Dialog UserDialog 342, 205, "Hesap Makinesi"
TextBox 59, 18, 223, 26, .Calculator
Text 17, 4, 303, 13, "Formⁿlⁿ giriniz:"
PushButton 25, 114, 44, 21, "1" 'Choice 1
PushButton 85, 114, 44, 21, "2" '2
PushButton 145, 114, 44, 21, "3" '3
PushButton 25, 86, 44, 21, "4" '4
PushButton 85, 86, 44, 21, "5" '5
PushButton 145, 86, 44, 21, "6" '6
PushButton 25, 56, 44, 21, "7" '7
GroupBox 199, 44, 128, 124, ""
PushButton 85, 56, 44, 21, "8" '8
PushButton 145, 56, 44, 21, "9" '9
PushButton 25, 143, 44, 21, "0" '10
PushButton 85, 143, 44, 21, "░" '11
PushButton 145, 143, 44, 55, "&OK" '12
PushButton 212, 114, 44, 21, "+" '13
PushButton 266, 86, 44, 21, "--" '14
PushButton 212, 86, 44, 21, "X" '15
PushButton 212, 55, 44, 21, "/" '16
PushButton 266, 55, 44, 21, "%" '17
PushButton 266, 114, 44, 21, "&Sq" '18
PushButton 212, 141, 44, 21, "&Rt" '19
PushButton 266, 141, 44, 21, "&$" '20
PushButton 217, 174, 88, 21, "&Bitti" '21
End Dialog
Dim dlg As UserDialog
dlg.Calculator = Calc$
Choice = Dialog(dlg)
Print Choice
Calc$ = dlg.Calculator
Print Calc$
If Choice = 21 Then Goto Quit
Select Case Choice
Case 1
Calc$ = Calc$ + "1"
Case 2
Calc$ = Calc$ + "2"
Case 3
Calc$ = Calc$ + "3"
Case 4
Calc$ = Calc$ + "4"
Case 5
Calc$ = Calc$ + "5"
Case 6
Calc$ = Calc$ + "6"
Case 7
Calc$ = Calc$ + "7"
Case 8
Calc$ = Calc$ + "8"
Case 9
Calc$ = Calc$ + "9"
Case 10
Calc$ = Calc$ + "0"
Case 11
Calc$ = Calc$ + "."
Case 12
On Error Goto Mistake
For i = 1 To Len(Calc$)
If Asc(Mid$(Calc$, i, 1)) = 32 Then
NCalc$ = NCalc$ + "+"
Goto Try2Again
Else
NCalc$ = NCalc$ + Mid$(Calc$, i, 1)
End If
Try2Again:
Next
Print NCalc$
Calc$ = NCalc$
NCalc$ = ""
Temp$ = ""
If InStr(Calc$, "$") Then Temp$ = "$"
n = ToolsCalculate(Calc$)
If Temp$ = "$" Then
n = ((n * 100) + 0.5) / 100
Else
End If
Calc$ = Str$(n)
For i = 1 To Len(Calc$)
If Asc(Mid$(Calc$, i, 1)) = 32 Then
Goto TryAgain
Else
NCalc$ = NCalc$ + Mid$(Calc$, i, 1)
End If
TryAgain:
Next
Calc$ = Temp$ + NCalc$
NCalc$ = ""
If Temp$ = "$" Then
If InStr(Calc$, ".") = 0 Then
Calc$ = Calc$ + ".00"
ElseIf InStr(Calc$, ".") Then
Calc$ = Left$(Calc$, InStr(Calc$, ".") + 2)
Else
End If
End If
Begin Dialog UserDialog 342, 205, "Hesap Makinesi"
PushButton 72, 143, 88, 21, "&Evet"
PushButton 190, 143, 88, 21, "&Hay²r"
Text 42, 25, 251, 13, "Hesaplama sonucu:"
TextBox 30, 65, 289, 18, .TextBox1
Text 30, 99, 285, 13, "Belgeye yap²■t²rmak iτin Evet'e, "
Text 30, 118, 259, 13, "Devam etmek iτin Hay²r'a bas²n"
End Dialog
Dim dlg2 As UserDialog
dlg2.TextBox1 = Calc$
yn = Dialog(dlg2)
If yn = 1 Then
WW2_Insert Calc$
Else
Goto Again
End If
Case 13
Calc$ = Calc$ + "+"
Case 14
Calc$ = Calc$ + "-"
Case 15
Calc$ = Calc$ + "*"
Case 16
Calc$ = Calc$ + "/"
Case 17
Calc$ = Calc$ + "%"
Case 18
Calc$ = Calc$ + "^2"
Case 19
Calc$ = Calc$ + "^(1/2)"
Case 20
Calc$ = "$" + Calc$
Case 22
Print "HelpDialog Sub"
Call HelpDialog
Case Else
Mistake:
Call ErrorTrap
On Error Goto 0
End Select
Goto Again
Quit:
End Sub
Sub ErrorTrap
L$ = Chr$(13)
Message$ = "Hesaplama hatas²" + L$ + "hesap makinesine geri d÷nⁿlⁿyor"
Title$ = "Hesaplama Hatas²"
MsgBox Message$, Title$, 16
End Sub